home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / 4dos / 4utilsf.zip / SCANLZHF.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-10  |  6KB  |  194 lines
  1. UNIT ScanLZHFiles;
  2. (* ----------------------------------------------------------------------
  3.    Part of 4DESC - A Simple 4DOS File Description Editor
  4.        and 4FF   - 4DOS File Finder
  5.  
  6.    (c) 1992 Copyright by David Frey,
  7.                          Urdorferstrasse 30
  8.                          8952 Schlieren ZH
  9.                          Switzerland
  10.  
  11.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  12.                and change it free of charge, but you may not sell or hire
  13.                this part of 4DESC. The copyright remains in our hands.
  14.  
  15.                If you make any (considerable) changes to the source code,
  16.                please let us know. (send a copy or a listing).
  17.                We would like to see what you have done.
  18.  
  19.                We, David Frey and Tom Bowden, the authors, provide absolutely
  20.                no warranty of any kind. The user of this software takes the
  21.                entire risk of damages, failures, data losses or other
  22.                incidents.
  23.  
  24.  
  25.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  26.  
  27.    This unit provides the string handling and the date/time handling.
  28.  
  29.    ----------------------------------------------------------------------- *)
  30.  
  31. INTERFACE USES Dos, Globals;
  32.  
  33. PROCEDURE SearchInLZHFile(FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  34.                           VAR Dir: PathStr; VAR lhsearch: SearchRec);
  35. PROCEDURE ShowCompLZHFileData(VAR search,lhsearch: SearchRec;VAR Path: PathStr;
  36.                               csize: LONGINT);
  37.  
  38. VAR OldLHFileName: PathStr;
  39.  
  40. IMPLEMENTATION USES Objects, Drivers, StringDateHandling;
  41.  
  42. VAR LHFile       : FILE;
  43.  
  44. PROCEDURE SearchInLZHFile(FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  45.                           VAR Dir: PathStr; VAR lhsearch: SearchRec);
  46.  
  47. VAR i        : WORD;
  48.     k, Dummy : BYTE;
  49.     LHAFile  : NameExtStr;
  50.  
  51. BEGIN (* SearchInLZHFile *)
  52.  Assign(LHFile,lhsearch.Name); Reset(LHFile,1);
  53.  
  54.  BlockRead(LHFile,Buffer^,BufSize,BytesRead); BufPtr := 2; FilePtr := 2;
  55.  (* first 2 unknown bytes skipped *)
  56.  REPEAT
  57.   s := '';
  58.   REPEAT
  59.    s := s+Chr(ReadByte);
  60.   UNTIL (Pos('-lh',s) > 0) OR (BufPtr > BytesRead);
  61.   Dummy := ReadByte; Dummy := ReadByte; (* overread Method *)
  62.  
  63.   IF BufPtr <= BytesRead THEN
  64.    BEGIN
  65.     csize       := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  66.     Search.size := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  67.     Search.time := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  68.     Search.attr := ReadByte;
  69.     Dummy := ReadByte; (* unknown 2 *)
  70.  
  71.     WITH Search DO
  72.      BEGIN
  73.       name  := ''; FOR i := 1 TO ReadByte DO name := name+DownCase(Chr(ReadByte));
  74.      END;
  75.  
  76.     FOR k := 1 TO FileSpecs DO
  77.      BEGIN
  78.       FSplit(FileSpec[k],Path,name,ext);
  79.       WHILE Length(name) < 8 DO name := name+' ';
  80.       IF Ext = '' THEN Ext := '.   '
  81.       ELSE
  82.        WHILE Length(ext)      < 4 DO ext := ext+' ';
  83.  
  84.       i := Pos('*',name);
  85.       IF  i > 0 THEN
  86.        WHILE i <= 8 DO
  87.         BEGIN
  88.          name[i] := '?'; INC(i);
  89.         END;
  90.  
  91.       i := Pos('*',ext);
  92.       IF  i > 0 THEN
  93.        WHILE i <= 4 DO
  94.         BEGIN
  95.          ext[i] := '?'; INC(i);
  96.         END;
  97.       FileSpec[k] := Path+name+ext;
  98.  
  99.       FSplit(Search.Name,Path,name,ext);
  100.       WHILE Length(name) < 8 DO name := name +' ';
  101.       IF Ext = '' THEN Ext := '.   '
  102.       ELSE
  103.        WHILE Length(ext)      < 4 DO ext := ext+' ';
  104.       LHAFile:= Path+name+ext;
  105.  
  106.       i := 1;
  107.       WHILE ((FileSpec[k][i] = '?') OR (FileSpec[k][i] = LHAFile[i])) AND
  108.              (i<12) DO
  109.        INC(i);
  110.  
  111.       IF ((ExactAttr AND (Search.Attr = Attr)) OR (NOT ExactAttr)) AND
  112.           (FileSpec[k][i] = '?') OR (FileSpec[k][i] = LHAFile[i]) THEN
  113.        ShowCompLZHFileData(search,lhsearch,Dir,csize);
  114.      END;
  115.  
  116.     INC(BufPtr,csize); INC(FilePtr,csize);
  117.     IF BufPtr > BufSize THEN
  118.      BEGIN
  119.       Seek(LHFile,FilePtr);
  120.       BlockRead(LHFile,Buffer^,BufSize,BytesRead); BufPtr := 0;
  121.      END;
  122.    END;
  123.  UNTIL BufPtr > BytesRead;
  124.  
  125.  Close(LHFile);
  126. END; (* SearchInLZHFile *)
  127.  
  128. PROCEDURE ShowCompLZHFileData(VAR search,lhsearch: SearchRec;VAR Path: PathStr;
  129.                               csize: LONGINT);
  130.  
  131. BEGIN
  132.  IF BareOutput THEN
  133.   Write(Output,Path,lhsearch.Name,' ')
  134.  ELSE
  135.   BEGIN
  136.    IF FileCount = 0 THEN
  137.     BEGIN
  138.      WriteLn(Output);
  139.      WriteLn(Output,Path);
  140.     END;
  141.  
  142.    IF lhsearch.Name <> OldLHFileName THEN
  143.     BEGIN
  144.      DownString(lhsearch.Name); OldLHFileName := lhsearch.Name;
  145.  
  146.      InfoArray[0] := LONGINT(@lhsearch.Name);
  147.  
  148.      SizeStr := FormattedLongIntStr(lhsearch.Size,8);
  149.      InfoArray[1] := LONGINT(@SizeStr);
  150.  
  151.      UnpackTime(lhsearch.Time,DateRec);
  152.      Date := FormDate(DateRec); Time := FormTime(DateRec);
  153.      InfoArray[2] := LONGINT(@Date);
  154.      InfoArray[3] := LONGINT(@Time);
  155.  
  156.      AttrStr := '....';
  157.      IF lhSearch.Attr AND Archive  = Archive  THEN AttrStr[1] := 'a';
  158.      IF lhSearch.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  159.      IF lhSearch.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  160.      IF lhSearch.Attr AND ReadOnly = ReadOnly THEN AttrStr[4] := 'r';
  161.      InfoArray[4] := LONGINT(@AttrStr);
  162.  
  163.      FormatStr(s,'(%-12s   %8s '+DateTempl+' '+TimeTempl+' %4s)',InfoArray);
  164.      WriteLn(Output,s);
  165.     END;
  166.  
  167.    InfoArray[0] := LONGINT(@search.Name);
  168.  
  169.    SizeStr := FormattedLongIntStr(search.Size,8);
  170.    InfoArray[1] := LONGINT(@SizeStr);
  171.  
  172.    UnpackTime(search.Time,DateRec);
  173.    Date := FormDate(DateRec); Time := FormTime(DateRec);
  174.    InfoArray[2] := LONGINT(@Date);
  175.    InfoArray[3] := LONGINT(@Time);
  176.  
  177. (*   AttrStr := '----';
  178.    IF Search.Attr AND Archive  = Archive  THEN AttrStr[1] := 'a';
  179.    IF Search.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  180.    IF Search.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  181.    IF Search.Attr AND ReadOnly = ReadOnly THEN AttrStr[4] := 'o'
  182.                                           ELSE AttrStr[4] := 'w';
  183.    InfoArray[4] := LONGINT(@AttrStr);
  184.  
  185.    FormatStr(s,'+ %-12s  %8s '+DateTempl+' '+TimeTempl+' %4s',InfoArray); *)
  186.    FormatStr(s,'+ %-12s  %8s '+DateTempl+' '+TimeTempl,InfoArray);
  187.    WriteLn(Output,s);
  188.  
  189.    INC(TotalSize,csize); INC(DirSize,csize);
  190.    INC(TotalFileCount);  INC(FileCount);
  191.   END;
  192. END; (* ShowFileData *)
  193.  
  194. END.